Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / VALIDATE.TPX < prev next >

Wrap

Text File | 1994-03-02 | 18KB | 466 lines

#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐ #!│ Validate.TPX │Version: 3007.105│ #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤ #!│Structure Type Description │ #!│──────────────────── ───────── ─────────────────────────────────────────│ #!│Validate PROCEDURE Lookup invalid field value from a file │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Repaired Validate PROCEDURE │ #!│3007.105 Repaired Validate PROCEDURE │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #PROCEDURE(Validate,'Lookup invalid field value from a file'),SCREEN,PULLDOWN #! #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐ #!│ Validate │Version: 3007.103│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Used as a Post-Edit (When Field Is Completed) procedure, to confirm that │ #!│an entered value is contained in a file. This functionality is replaced │ #!│in 3007 with the Browse Procedure, but is provided for compatability │ #!│with applications developed prior to 3007. │ #!│ │ #!│A Validate procedure MUST be called as a "When Field Is Completed" │ #!│procedure │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Changed UpdateProcedure ROUTINE (Added SELECT(?List)) │ #!│3007.103 Added support for SAV::PullDownOpened for Lookup. │ #!│ This support was added because any screen or pulldown needs to │ #!│ be closed so CHANGE only affect the calling screen. │ #!│ Added INSERT of SaveRangeFields to initialize SAV:: values if │ #!│ a Range Limit is used. │ #!│ Added call to %EditCodeLocator GROUP in CASE FIELD() code │ #!│3007.105 Completed support for PullDowns │ #!│ Modified ResetFirst code to handle initial load of current value│ #!└──────────────────────────────────────────────────────────────────────────┘ #! #MAP('BROWSE.INC') #PROJECT('%clapfx%BROWS.LIB') #PROTOTYPE('') #! #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField #PROMPT('Range &Value Field',FIELD),%RangeValue #PROMPT('Record Filter',@S180),%RecordFilter #PROMPT('Lookup Field',COMPONENT),%LookupField #PROMPT('Input Field Picture',@S30),%LookupPicture #PROMPT('Locator Field',COMPONENT),%Locator #PROMPT('Incremental Locator',CHECK),%IncrementalLocator #PROMPT('Display Key',KEY),%DisplayKey #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc #PROMPT('Enable Hot Records',CHECK),%HotBar #PROMPT('Lookup Hot Key',KEYCODE),%LookupHotKey #PROMPT('Disable Memo Access',CHECK),%NoMemo #! #INSERT(%SetBrowseSymbols) #IF(%LookupField = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: Lookup Field is required.')) #ERROR(%ErrorMessage) #ENDIF #! #FIX(%File,%Primary) #SET(%LookupKey,%PrimaryKey) #FIX(%Field,%LookupField) #! #IF(%FieldType='STRING' OR %FieldType='CSTRING' OR %FieldType='PSTRING') #SET(%LookupType,'STRING') #ENDIF #IF(%DisplayKey = %Null) #SET(%DisplayKey,%PrimaryKey) #ENDIF #INSERT(%BrowseErrorCheck) #INSERT(%StandardHeader) %Procedure PROCEDURE #FIX(%ScreenField,'?List') Queue QUEUE STRING(%ScreenFieldQueueSize) END #INSERT(%SetupKeyRangeFields) #IF(%UpdateProc) UpdateMode BYTE(0) UpdateSuccessful BYTE(0) #ENDIF #IF(%LookupPicture) DeformatString STRING(80) #ENDIF ButtonIsDisabled BYTE !Flag to allow button enable #INSERT(%FileControl) #IF(%KeyRangeField) #IF(%TotalExists) InitTotals BYTE(1) #ENDIF #ENDIF CalledAsLookup BYTE(1) ListInitialized BYTE(0) InitialLoad BYTE(1) %LocalData %ScreenStructure #IF(%PullDownStructure) SAV::PullDownOpened BYTE(0) %PulldownStructure #ENDIF #EMBED('Data Section') CODE ListInitialized = FALSE #EMBED('Setup Procedure') #INSERT(%FileControl) #EMBED('Before Validate Lookup') #IF(%LookupHotKey) IF KEYCODE() <> %LookupHotKey #<!If not requested by hot key #INSERT(%LookupRecord) END !End IF #ELSE #INSERT(%LookupRecord) #ENDIF OPEN(Screen) !Open the screen #EMBED('Setup Screen') DISPLAY !Display screen fields #INSERT(%SaveRangeFields) #IF(%Pulldown) #!If a Pulldown exists OPEN(%Pulldown) #<!Open the Pulldown SAV::PullDownOpened = True #EMBED('Setup Pulldown') #ENDIF #IF(%TotalExists) #IF(NOT %PreListEntry) DO InitializeTotals #ENDIF #ENDIF #INSERT(%AddFixedListLines) #INSERT(%BeginBrowse) ListInitialized = TRUE LOOP !Process browse requests #EMBED('Top of BrowseAction LOOP') CASE BrowseAction(%Primary,%DisplayKey,Queue)#<!Browse the file OF FormatQueue !Format a queue element #INSERT(%GetSecondaryRecords) #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'LIST') #INSERT(%Generateformula) #ENDIF #ENDFOR #EMBED('LIST Class formula') #FIX(%ScreenField,'?List') Queue = %ScreenFieldExpression !Format the queue line OF ProcessField !Process a field #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'LIST') #ELSIF(UPPER(%FormulaClass) = 'FILTER') #ELSIF(UPPER(%FormulaClass) = 'AVG') #ELSIF(UPPER(%FormulaClass) = 'SUM') #ELSIF(UPPER(%FormulaClass) = 'CNT') #ELSE #INSERT(%GenerateFormula) #ENDIF #ENDFOR #EMBED('End of General Formulas') #IF(%HotkeyExists) CASE KEYCODE() #FOR(%HotKey) OF %HotKey !User defined HotKey %HotKeyProc !HotKey Procedure #ENDFOR END #ENDIF IF SELECTED() <> FIELD() ! If a new field is selected CASE SELECTED() ! Jump to setup routine #INSERT(%ScreenSetupRoutines) END #IF(%KeyRangeField) IF SELECTED() = ?List #IF(%TotalExists) #IF(%PreListEntry) SAV::RangeValueChanged = False IF InitTotals SAV::RangeValueChanged = True InitTotals = False ELSE #INSERT(%RangeComparison) SAV::RangeValueChanged = True END END #ENDIF #ENDIF #INSERT(%SaveRangeFields) #IF(%TotalExists) #IF(%PreListEntry) IF SAV::RangeValueChanged DO InitializeTotals END #INSERT(%RestoreRangeFields) #ENDIF #ENDIF END #ENDIF END ! End IF CASE FIELD() !Jump to edit routine #FOR(%ScreenField) #IF(%ScreenField = '?Insert') #INSERT(%EditCodeInsert) #ELSIF(%ScreenField = '?Change') #INSERT(%EditCodeChange) #ELSIF(%ScreenField = '?Delete') #INSERT(%EditCodeDelete) #ELSIF(%ScreenField = '?Select') OF ?Select #INSERT(%LookupValidateCode) #ELSIF(%ScreenField = '?List') #INSERT(%EditCodeList) #ELSIF(%ScreenField = '?Cancel') #INSERT(%EditCodeCancel) #ELSIF(%ScreenField = '?Exit') #INSERT(%EditCodeExit) #ELSIF(%ScreenFieldUse=%Locator) #INSERT(%EditCodeLocator) #ELSE #INSERT(%ScreenEditRoutines) #ENDIF #ENDFOR #INSERT(%PulldownEditRoutines) END !End CASE FIELD() OF NoRecords !No records to browse #EMBED('Case Of No Records Found') #INSERT(%ClearFileFields) #INSERT(%RestoreRangeFields) DISPLAY IF RECORDS(%Primary) #<!If file is not empty IF ?List <> %FirstEntryField #<! And list is not first SELECT(%FirstEntryField) #<! Select the first field ELSE ! From the first field #IF(%UpdateProc) #IF(%InsertExists) SELECT(?Insert) ! Select the Insert Button #ELSE #INSERT(%RestoreRangeFields) SETKEYCODE(InsKey) ! Ask for a new record DO UpdateProcedure ! Call the update procedure IF POSITION(%DisplayKey) = '' #<! If record not added BREAK ! Return to caller END ! End IF #ENDIF #ELSE BREAK ! Return to caller #ENDIF END ! End IF ELSE !If file is empty #IF(%UpdateProc) #INSERT(%ClearFileFields) #INSERT(%RestoreRangeFields) SETKEYCODE(InsKey) ! Ask for a new record Do UpdateProcedure ! Call the update procedure IF RECORDS(%Primary) = 0 #<! If a record was not added BREAK END ! End IF #ELSE BREAK ! Return to caller #ENDIF END !End IF #IF(%FilterExists OR %KeyRangeField) OF FilterRecord !Should we add this record IF ButtonIsDisabled #IF(%ChangeExists) ENABLE(?Change) ! Enable the change button #ENDIF #IF(%DeleteExists) ENABLE(?Delete) ! Enable the delete button #ENDIF ButtonIsDisabled = FALSE END #INSERT(%CheckKeyRangeFields) #IF(%RecordFilter) IF ~(%RecordFilter) #<!If Filter condition not met GET(%Primary,0) #<! Dereference the record CYCLE ! Return to Top of LOOP END !End IF #ELSE #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<!If Filter condition not met GET(%Primary,0) #<! Dereference the record CYCLE ! Return to Top of LOOP END !End IF #ELSE IF ~(%FormulaComputation) #<!If Filter condition not met GET(%Primary,0) #<! Dereference the record CYCLE ! Return to Top of LOOP END !End IF #ENDIF #ENDIF #ENDFOR #ENDIF #EMBED('After Filter and Range Check') #ENDIF OF ResetFirst !Set to first in a Range #IF(%KeyRangeField) #INSERT(%ClearRecordLow) #INSERT(%RestoreRangeFields) SET(%DisplayKey,%DisplayKey) #<! SET to the closest match #ELSE IF InitialLoad SET(%DisplayKey,%DisplayKey) #<! SET to the closest match InitialLoad = False ELSE SET(%DisplayKey) END #ENDIF #EMBED('Set to First Record') OF ResetLast !Set to last in a Range #IF(%KeyRangeField) #INSERT(%ClearRecordHigh) #INSERT(%RestoreRangeFields) SET(%DisplayKey,%DisplayKey) #<! SET to the closest match #ELSE SET(%DisplayKey) #<! SET to the closest match #ENDIF #EMBED('Set to Last Record') #IF(%HotBar) OF ProcessSelected !Process highlighted record #INSERT(%GetSecondaryRecords) #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #ELSIF(UPPER(%FormulaClass) = 'AVG') #ELSIF(UPPER(%FormulaClass) = 'SUM') #ELSIF(UPPER(%FormulaClass) = 'CNT') #ELSE #INSERT(%GenerateFormula) #ENDIF #ENDFOR #EMBED('Process Selected Record') #SET(%ListFieldNumber,%Null) #SET(%LastFieldNumber,%Null) #FOR(%ScreenField) #SET(%LastFieldNumber,(%LastFieldNumber+1)) #IF(UPPER(%ScreenField)='?LIST') #SET(%ListFieldNumber,(%LastFieldNumber+1)) #ENDIF #ENDFOR DISPLAY(%ListFieldNumber,%LastFieldNumber) #<! Display the hot fields #ENDIF END !End CASE END !End LOOP DO ProcedureReturn #IF(%TotalExists) !───────────────────────────────────────────────────────────────────────────── InitializeTotals ROUTINE Total:Posit" = POSITION(%Primary) #IF(%KeyRangeField) CLEAR(%FilePre:RECORD,-1) #INSERT(%RestoreRangeFields) SET(%PrimaryKey,%PrimaryKey) #<! SET to the closest match #ELSE SET(%PrimaryKey) #<! SET to top of file #ENDIF #INSERT(%ClearTotalValues) #EMBED('Set to First Record Before Total Loop') LOOP NEXT(%Primary) IF ERRORCODE() THEN BREAK. #EMBED('Inside Total Loop, Immediatly After NEXT()') #IF(%KeyRangeField) #INSERT(%RangeComparison) BREAK END #ENDIF #IF(%RecordFilter) IF ~(%RecordFilter) #<!If Filter condition not met CYCLE #<! Return to Top of LOOP END #<!End IF #ELSE #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<!If Filter condition not met CYCLE ! Return to Top of LOOP END !End IF #ELSE IF ~(%FormulaComputation) #<!If Filter condition not met CYCLE ! Return to Top of LOOP END !End IF #ENDIF #ENDIF #ENDFOR #ENDIF #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<!If Filter condition not met CYCLE ! Return to Top of LOOP END !End IF #ELSE IF ~(%FormulaComputation) #<!If Filter condition not met CYCLE ! Return to Top of LOOP END !End IF #ENDIF #ENDIF #ENDFOR #INSERT(%GetSecondaryRecords) #EMBED('Inside Total Loop, After Filter') #INSERT(%AddTotalValues) END #INSERT(%UpdateTotalValues) #EMBED('After Total Field Loop') #IF(%KeyRangeField) CLEAR(%FilePre:RECORD,-1) #INSERT(%RestoreRangeFields) #ENDIF IF Total:Posit" RESET(%Primary,Total:Posit") NEXT(%Primary) END DISPLAY #ENDIF #IF(%UpdateProc) !───────────────────────────────────────────────────────────────────────────── UpdateProcedure ROUTINE #INSERT(%TotalBeforeUpdate) #EMBED('Prior to Update Procedure') %UpdateProc #INSERT(%IsUpdateSuccessful) #EMBED('After Update Procedure') #INSERT(%TotalAfterUpdate) #INSERT(%RestoreRangeFields) #IF(%KeyRangeField) CLEAR(%FilePre:RECORD,-1) #INSERT(%RestoreRangeFields) #ENDIF SELECT(?List) #ENDIF #! !───────────────────────────────────────────────────────────────────────────── ProcedureReturn ROUTINE IF ListInitialized EndBrowse !End the browse session END FREE(Queue) !Free the Queue memory #IF(%Pulldown) #!If a Pulldown exists IF SAV::PullDownOpened CLOSE(%Pulldown) #<!Close the Pulldown SAV::PullDownOpened = False END #ENDIF #EMBED('Before Closing Files') #INSERT(%FileControl) DO EndOfProcedureEmbed RETURN !───────────────────────────────────────────────────────────────────────────── EndOfProcedureEmbed ROUTINE #EMBED('End of Procedure') #EMBED('Custom Routines') #CHAIN('Select.tpx')